﻿' License GNU LESSER GENERAL PUBLIC LICENSE - http://www.gnu.org/copyleft/lesser.html
' By Ycaro Afonso - http://ycaro.net/tag/dotnetxmlhttprequest/

Imports Microsoft.VisualBasic
Imports System.Net
Imports System.IO

<Obsolete("Obsolete class in VB")> _
Public Class XMLHttpRequest
    Implements System.IDisposable

    Private pSend As String = String.Empty

    Private pResponseText As Object

    Private pUri As Uri
    Private request As HttpWebRequest
    Private pMethod As EnumMethod
    Private response As HttpWebResponse = Nothing

    Private pReadystate As States

    Private pTimeOut As Integer = 20000

    Public Sub New()
    End Sub

    Public Enum States
        UNSENT = 0
        OPENED = 1
        HEADERS_RECEIVED = 2
        LOADING = 3
        DONE = 4
    End Enum

    Public ReadOnly Property readystate() As States
        Get
            Return pReadystate
        End Get
    End Property

#Region "Open"

    ''' <summary>
    ''' http://www.w3.org/TR/XMLHttpRequest/#the-open-method
    ''' </summary>
    ''' <param name="method"></param>
    ''' <param name="url"></param>
    ''' <remarks></remarks>
    Public Sub Open(ByVal method As EnumMethod, ByVal url As String)
        pReadystate = 0
        pMethod = method
        pUri = New Uri(url)
        request = HttpWebRequest.Create(pUri)
        request.Timeout = pTimeOut
    End Sub

    Public Sub Open(ByVal _Method As EnumMethod, ByVal _Url As String, ByVal Username As String, ByVal Password As String)
        Open(_Method, _Url)
        request.Credentials = New NetworkCredential(Username, Password)
    End Sub

#End Region

    ''' <summary>
    ''' http://www.w3.org/TR/XMLHttpRequest/#the-setrequestheader-method
    ''' </summary>
    ''' <param name="header"></param>
    ''' <remarks></remarks>
    Public Sub setRequestHeader(ByVal header As String, ByVal value As Object)
        If request.Headers(header) Is Nothing Then
            request.Headers.Add(header, value)
        Else
            request.Headers(header) = value
        End If
    End Sub

#Region "Send"

    ''' <summary>
    ''' http://www.w3.org/TR/XMLHttpRequest/#the-send-method
    ''' </summary>
    ''' <param name="Data"></param>
    ''' <remarks></remarks>
    Public Sub Send(ByVal Data As String)
        pSend = Data

        Try
            If pMethod = EnumMethod.POST Then
                request.Method = "POST"

                Dim _data As Byte() = Text.Encoding.Default.GetBytes(pSend)
                request.ContentType = "application/x-www-form-urlencoded"
                request.ContentLength = Data.Length
                Dim newStream As Stream = request.GetRequestStream()
                newStream.Write(_data, 0, _data.Length)
                newStream.Close()
            End If

            response = request.GetResponse()

            pReadystate = States.DONE


            If response.Headers("Content-Type").Split("/")(0).Split("/")(0) = "text" Then
                Dim responseReader As IO.StreamReader = Nothing
                Try
                    If response.GetResponseStream() IsNot Nothing Then
                        responseReader = New IO.StreamReader(response.GetResponseStream())
                        pResponseText = responseReader.ReadToEnd()
                    Else
                        pResponseText = String.Empty
                    End If
                    ' Catch ex As Exception
                Finally
                    If pResponseText <> String.Empty Then _
                        responseReader.Close()
                End Try
            End If
        Catch ex As WebException
            response = DirectCast(ex.Response, HttpWebResponse)
            pReadystate = States.DONE

            If response Is Nothing Then
                Throw New Exception("Ocorreu um erro no request que não é um HTTP ERROR") ' TODO: 
            End If
        Finally

        End Try
    End Sub

    Public Sub Send()
        Send(String.Empty)
    End Sub

#End Region

    ''' <summary>
    ''' TODO: 
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub Abort()
        request.Abort()
    End Sub

#Region "Response"

#Region "Status"

    ''' <summary>
    ''' http://www.w3.org/TR/XMLHttpRequest/#the-status-attribute
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property Status() As Integer
        Get
            Return response.StatusCode
        End Get
    End Property

    ''' <summary>
    ''' http://www.w3.org/TR/XMLHttpRequest/#the-statustext-attribute
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property StatusText() As String
        Get
            Return response.StatusDescription
        End Get
    End Property

#End Region

#Region "Header"

    ''' <summary>
    ''' http://www.w3.org/TR/XMLHttpRequest/#the-getresponseheader-method
    ''' </summary>
    ''' <param name="header"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function getResponseHeader(ByVal header As String) As String
        Return String.Concat(header, ": ", response.Headers(header))
    End Function
    Public Function getResponseHeader(ByVal header As Integer) As String
        Return String.Concat(response.Headers.Keys(header), ": ", response.Headers(header))
    End Function

    ''' <summary>
    ''' http://www.w3.org/TR/XMLHttpRequest/#the-getallresponseheaders-method
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function getAllResponseHeaders() As String
        Dim retorna As New Text.StringBuilder
        For x As Integer = 0 To response.Headers.Count - 1
            retorna.AppendFormat("{0}: {1}; ", response.Headers.Keys(x), response.Headers(x))
        Next
        Return retorna.ToString
    End Function

#End Region

    ''' <summary>
    ''' http://www.w3.org/TR/XMLHttpRequest/#the-responsetext-attribute
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property responseText() As Object
        Get
            Return pResponseText
        End Get
    End Property

    ''' <summary>
    ''' TODO: 
    ''' http://www.w3.org/TR/XMLHttpRequest/#the-responsexml-attribute
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function responseXML() As Object
        Throw New Exception
    End Function

#End Region


#Region "Outros métodos"

    Public Sub Send(ByVal parameter As Dictionary(Of String, Object))
        Dim str As String = String.Empty
        For Each item As KeyValuePair(Of String, Object) In parameter
            str = String.Concat(str, item.Key, "=", item.Value, "&")
        Next
        Send(str.ToString.Trim("&"))
    End Sub

    Public Property TimeOut() As Integer
        Get
            Return pTimeOut
        End Get
        Set(ByVal value As Integer)
            pTimeOut = value
        End Set
    End Property

    Private pUrl As String

#Region "Métodos que não são do XMLHttpRequest"

    Public ReadOnly Property ResponseContentType() As String
        Get
            Return response.ContentType
        End Get
    End Property

    Public ReadOnly Property Url() As String
        Get
            Return pUri.AbsolutePath
        End Get
    End Property

    Public ReadOnly Property Domain() As String
        Get
            Return pUri.Host
        End Get
    End Property

    Public ReadOnly Property Diretorios() As String()
        Get
            Return pUri.Segments
        End Get
    End Property

    Public ReadOnly Property responseStream() As Stream
        Get
            Return response.GetResponseStream()
        End Get
    End Property

    ' TODO: 
    'Public Function responseDataTable(ByVal indexTable As Integer) As Data.DataTable
    '    Dim ds As New Data.DataSet
    '    ds.ReadXml(New IO.StringReader(responseText), Data.XmlReadMode.Auto)
    '    If ds.Tables.Count > 0 Then
    '        Return ds.Tables(indexTable)
    '    Else
    '        Throw New Exception("Não possui uma tabela.")
    '    End If
    'End Function

#End Region

    Public Enum EnumMethod
        POST
        [GET]
    End Enum

#End Region


#Region "IDisposable"

    Private disposedValue As Boolean = False        ' To detect redundant calls

    ' IDisposable
    Protected Overridable Sub Dispose(ByVal disposing As Boolean)
        If Not Me.disposedValue Then
            If disposing Then
                response.GetResponseStream().Close()
                response.GetResponseStream().Dispose()
                response.Close()
            End If

            ' TODO: free your own state (unmanaged objects).
            ' TODO: set large fields to null.
        End If
        Me.disposedValue = True
    End Sub

#Region " IDisposable Support "
    ' This code added by Visual Basic to correctly implement the disposable pattern.
    Public Sub Dispose() Implements IDisposable.Dispose
        ' Do not change this code.  Put cleanup code in Dispose(ByVal disposing As Boolean) above.
        Dispose(True)
        GC.SuppressFinalize(Me)
    End Sub
#End Region

#End Region ' IDisposable

End Class
